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FFF 000 000 RRR RRR RRR = RRR TTT LLL 

FFF 000 000 RRR RRR RRR = =RRR TTT LLL 

FFF 000 RRR RRR RRR = RRR TTT LLL 

FFF 000 000 RRR RRR RRR RRR TTT LLL 

FFF 000 000 RRR RRR RRR RRR TTT LLL 

FFF 0 000 RRR RRR RRR RRR TTT LLL 

FFF 000000000 RRR RRR RRR RRR TTT LLLLLLLLLLELLLL 
FFF 000000000 RRR RRR RRR RRR TTT LLLLLLLLLLELLLL 
FFF 000000000 RRR RRR RRR RRR TTT LLLLELLLLLLLLLL 
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MODULE FORSSFMTCP (XZTITLE*FORTRAN OBJECT TIME FORMAT cor ays 
IDENT = *2-006' ! File: FORFMTCP.B Edit: SBL2006 
BEG! 


SRR AREA AARAAEE REAR AAA AA REAR AREER EATER AERA ERA EATER EEE 


ie COPYRIGHT (c) 1978, 1980, 1982, 1984 8 
' DIGITAL EQUIPMENT EORPORATION, MAYNARD. MASSACHUSETTS. 
'w ALL RIGHTS RESERVED. 


® 
® 
® 
® 
® 
iw THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED * 
i ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE 
is INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER 
is COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY * 
iw OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY * 
ie TRANSFERRED. : 
5 * 
ix THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE * 
i® AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT * 
i CORPORATION. . 

® 

® 

® 

® 

® 

® 


!* DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS 
:* SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. 


Lee RRR RAARAAARAAEEREAAEAERAAAAAAEEEAEEAETEAAEAEAEAAAAAAAAARAEAAAETAEEEEEEEE 
' 


a a a kk kk kk kt kt tk tt tt OOOO 
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1 
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1 

1 

1 

1 

1 

1 

1 

2 

2 

2 

2 

2 

2 

2 

2 
2 002 
2 B36 '+4 

; it FACILITY: FORTRAN SUPPORT LIBRARY | 
3 003 | ABSTRACT: | 
3 003 ! This module is the run-time FORTRAN format gouptior pyeoeran _COMPIL. 
3 003 : It translates a format into the same form that the FORT 
3 003 : compiler does. This module is adapted from the we a pe 

3 0037 : compiler module, therefore changes in this module should be 
3 O035 evaluated to see if the compiler should be changed, and vice versa. 
: o049 : ENVIRONMENT: User access mode; AST re-entrant | 
? S94 AUTHOR: Peter Yuo, CREATION DATE: 07-June-77 

4 0044 ' MODIFIED BY: 

4 0045 : 

4 0046 : Joel Clinkenbeard (FORTRAN IV-PLUS) 

4 0047 ! Steven B uy nel (Run-Time Library) 
o 0048 : Version 2 15-May-1979 
4 0049 ‘ 
2 pots EDIT HISTORY: 
5 B36 i 2-001 - Yesere to_level of Version 2.0 coarRas H compiler. including 

5 005 i N-77 format codes. SBL 15-May-19 

5 0054 i 2-002 - X is now the same as TR. SBL 2-Aug-1979 

5 0055 i 2-003 - ELiminate an extraneous RETURN Penrersion, JBS 06-SEP-1979 

5 0056 ! 2-004 = Allow sequences such as without error. SBL 18-Dec-1979 

5 0057 ! 2-005 = Allow null characters in quoted’ licteste and Hollerith Literals. 


nom 
1o 


ice eae es hehe opts ee te ere 


SPR 11=44210 SBL 1-March-1982 
! j e-00e - obey w valug. jo be zero; new extension for V4. Use prologue file. 
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oO 
oOo 


} 
| 
° ger ti 
; 65 064 1 ! PROLOGUE FILE: 
; «666 006 1! | 
; «67 066 1 
; of 90 f | REQUIRE "RTLIN:FORPROLOG'; ' FORTRAN definitions | 
oe 0 . a 
2 135 1 | LINKAGES: 
; i 01 § 1: | 
RGM 0137 #1 
 . ot 8 1 LINKAGE 
eee 139 1 CALL_G3 = CALL : GLOBAL (SAVVAL = 11, SAVTYP = 10, PTR = 9); 
; 76 0140 1 
TES 0141 1! | 
; «78 0148 1! TABLE OF CONTENTS: 
; 79 0143 1! 
; 80 0144 1 
; «1 0145 1 FORWARD ROUTINE 
: 82 0146 1 FORSSFMT_COMPIL NOVALUE, 
> «6883 0147 1 REDUCE :"NOVALUE CALL_G3, 
; B4 0148 1 DEFE NOVALUE CALL_63, 
; 685 0149 1 UNDEFER : NOVALUE CACL_G3, 
: 86 0150 1 NZERO : NOVALUE CALL_G3, 
; «687 0151 1 NSAVE : NOVALUE CALL~G3 
: 88 O15¢ 1 PUTBYT : NOVALUE CALC_G3, 
3 89 015 1 BYTSIZ; 
: 90 0154 1 
: (91 0155 1! 
; 9 0156 1°! MACROS: 
; 9 0157 1! 
: 94 0158 1 
. owe 0159 1 MACRO 
; 496 m 0160 1 ERROR (ERR_SYM) = 
; oF M0161 1 (FORSSSIGNAL_STO (FORSK_SYNERRFOR); 
; 698 O16¢ 1 RETURN (0)) &, 
; m 0168 1 XT_REG = | 
: 100 M0164 1 EXTERNAL REGISTER 
: 101 M0165 1 SAVVAL: REF VECTORE LONG], | 
; 108 M0166 1 SAVTYP: REF VECTORL,LONG, 
: 10 0167 1 PTR: REF VECTORL.LONG) %, 
: 104 m 0168 1 GC = | 
: 105 M0169 1 
: 106 0170 1 CHSRCHAR_A (FORMAT_PTR) %, 
>: 107 M0171 1 GNB = 
; 108 i 0178 1 
: 109 mO173 1 BEGIN - 
: 110 M0174 1 FORMAT_PTR = CHSFIND_NOT_CH (K_MAX_LENGTH, .FORMAT_PTR, %C' ') ; 
> 111 ™ 0178 1 IF CHSFAIL (.FORMAT_PTR) 
: 11g 176 1 THEN 
: 11 M0177 1 ERROR (ERRFMTCHAR); 
> 114 M0178 1 BEGIN 
: 115 m 0179 1 LOCAL 
: 116 ™0180 1 C; 
> 117 m 0181 1 C = CHSRCHAR_A (FORMAT_PTR); 
> 118 m 01 ‘ 1 IF (.C GEQU ZC'a') AND (.C LEQU %C'z") 
+ 119 Mm 01 1 THEN 
: 120 M0184 1 .C = (8C'a® = ICA") 
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ELSE 


END 
END %; 
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= 


EXTERNAL RE“ERENCES: 
EXTERNAL ROUTINE 
FORSSGE 


VM, 
FORSSFREE_VM : NOVALUE, 
FORS$SIGNAL_STO : NOVALUE; 


Get dynamic virtual memory 
Free dynamic virtual memory 
signal=stop FORS$_abcmnoxyz, given 


—s— 


(short) Fortran error number (FORSK_abcmnoxyz) 
as a parameter 


OWN STORAGE: 
NONE 
EQUATED SYMBOLS: 


LITERAL 
K_FMT_BUF_INIT = 256. ' initial length (bytes) of format buffer 
K_-MAX_LENGTH = 65535, ! max. length of input character array 


14 
Define offsets into LOCAL VECTOR pointed to by GLOBAL register PTR 


L_FDEFER = 0, ! format code for deffered item 

L_FCOUNT = 1, ' count of W, D, for deferred item 

L“PHASE = 2, i index to SAVVAL and SAVTYP 

L_NEST = 3, ! parenthesis nest level 

L_SIGN = 4, ! non-zero if minus sign seen 

L_NVAL = 5, ' value of numberic item 

L_TYPE = 6 ! eype of numeric item 

L“NCHAR = 7? i character index within FMT_BUF 

ALENT BUF BEG = 8, pesnyer +e Soatensra of compiled output 
mi = ! previous character 

L_FMT_ UF _S12 = 10, ' current size (bytes) of dynamically allocated format buffer 


+ 
Define size constants for the LOCAL structures 
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K_PTR_ SIZ = 11, ! No. of local variables perates to by PTR 
5 K-SAVVAL_SIZ = 4, ! No. of longwords in SAVVAL 
6 K_SAVTYP_SIZ = 4, ' No. of lLongwords in SAVTYP 
K-PTR_OFFSET = K_SAVVAL_SIZ + K_SAVTYP_SIZ, } Oftset into local storage 
! o 
; , K_LOCAL_SIZ = K_PTR_OFFSET + K_PTR_SIZ; ! Total size of LOCAL storage (longwords) 
1 BIND 
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GLOBAL no FORSSFMT_COMPIL ( UN-TIME FORMAT COMPILER 


R 
: poorere of the source format statement 
A 


ALLOCATED_LEN, ' Length of the encoded format 
See ce wn ! Address of the encoded format | 


006 
H 1 94 «1 
; ¢ 95 1 
; 39 1 
3 4 97 1 
3 5 98 1 
3 § 99 1 
; $Y 1 !44 
: $6 4 : FUNCTIONAL DESCRIPTION: 
; 240 0 8 1! Process the format statement. If there is any illegal 
: 241 0304 1! character encounted, calls error routine and return. 
3 stg 8 05 1! Otherwise, it will process each format code one at a time 
; 26 BS 1: and output compiled encoding whenever all the information 
; ek 0307 1! has been gathered. 
: 265 0308 1! | 
; 246 0309 1 ! FORMAL PARAMETERS: 
; 2467 0310 1! 
; 248 0511 1! FORMAT. rbu.ra Address of the source format statment text 
: 249 Bai§ 1! ALLOCATED_LEN.ww.r Address of a word containing the Length of the 
; 250 0315 1! compiled format encoding fori the source 
3 2) 0314 1! format statement 
; 26 0315 1! ALLOCATED_ADR.wa.r Address of a longword containing the 
ee | 0316 1! address of the compiled format encoding for 
> 254 0317 1! the source format statement 
; @ 0318 1! 
; 256 0319 1 ! IMPLICIT INPUTS: 
. gay 0320 1! 
3; 258 0321 1! NONE 
; 259 8356 1! 
; 260 0325 1! 
3: 261 0324 1°! IMPLICIT OUTPU‘S: 
3 $66 0325 1! 
; 2 0356 . FMTDAT array 
: 264 0327 1! | 
; 265 0328 1 ! ROUTINE VALUE: 
: 266 0368 1! | 
3; 267 0330 1! NONE 
; 268 0331 1! 
; Hs Oa88 : SIDE EFFECTS: | 
3 eri 0334 1! SIGNAL_STOPs FORSSYNERRFOR (62=""SYNTAX ERROR IN FORMAT") 
; si¢ O3¢2 1! 
; 27 0336 1 !-- 
3 274 o33e 1 
3; es 338 § BEGIN | 
3 6¢fé the 
: 207 340 MAP | 
; 78 0341 ALLOCATED_LEN : REF VECTOR Ft. WORD], 
3 ie 4 3ae6 ALLOCATED_ADR : REF VECTOR (1, LONG); | 
; 281 O34 GLOBAL REGISTER 
: 282 345 SAVVAL = 11 : REF VECTOR FR. SAVVAL S123. ! pointer to value N, W, D 
; 285 0346 SAVTYP = 10 : REF VECTOR CK_SAVIYP_SIZJ, ! pointer to type of N, WwW, D 
3 Be 0348 PTR = 9 : REF VECTOR CK_PTR_SIZ); ! pointer to rest of LOCAL array 
: 86 349 LOCAL 
3 0350 


@ 
™~N 


HAR, ! LAST CHARACTER FROM SOURCE 
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FORSSFMTCP 
2-006 14- =Sep- FORRTL.SRC FORFMTCP, “235, 31 (3). 

88 FORMA ' Address of last character from source 

34 FMTD - MVECTOR CK_LOCAL_S1Z]; ! impure data for format processing 

91 1+ 

9 ! Bind names to LOCAL eayphy 24 for this routine only. Calls to other routines 

4, access these locations using .PTR[L_name]. 

95 3 
296 3 BIND 
297 3 FDEFER = FMTDAT CK_PTR_OFFSET + ett e ' FORMAT ‘i 4s DEFERRED ITEM 

98 FCOUNT = FMTDAT CK-PTR-OFFSET + L-FCOUNTJ, ! COUNT OF D FOR DEFERRED ITEM 

99 PHASE = FaTOAT CK “BTR OFFSET + L_PHASE), ' INDEX 19 SAVVAL AND SAVTYP 

00 EST = FMTDAT CK_PTR_OFFSET + L_RESTJ, ! PARENTHESIS NEST LEVEL 
301 ; SIGN = FMTDAT LK_PTR_OFFSET + L_SIGNJ], ! -1 if neg, 1 if pos 0 if no sign 
308 NVAL = FMTDAT CK-PTRIOFFSET + L-NVALJ, / VALUE OF NUMERIC ITEM | 
30 3 TYPE = FMTDAT CK_PTR_OFFSET + L_TYPEJ, ! TYPE OF NUMERIC ITEM 
304 : ! =] = VARIABLE FORMAT EXPRESSION 
305 ' © = NOT PRESENT 
306 3 ! +1 = CONSTANT 
307 3 NCHAR = FMTDAT CK_PTR_OFFSET + NCHAR], ! CHARACTER INDEX WITHIN FMT_BUF 
308 3 FMT_BUF_BEG = FMTBDAT Ck_ PTR OFFSET + AL FMT BUF BEG), 

309 3 ' Bo INTER 10 BEGINING OF COMPILED OUTPUT FORMAT BUFFER 
1 3 CPRIME = FMTDAT CK_PTR_OFFSET + L_CPRIME} PREVIOUS CHARACTER 
; FMT_BUF_SIZ = FM MTDAT CR_P PTR OFFSET ° ha FMT BUF siz). 
; ' CURRENT ALLOCATION FOR DYNAMICALLY ALLOCATED FORMAT BUFFER 


14 
t Setup GLOBAL registers to be passed to other routines 


SAVVAL = pat +! + bee ' Set pointer to value of N, _ D parameters 
SAVTYP = FM K SAVVAL 12); ' Set pointer to type of N, W, D parameters 
PTR = PEMTDAT. tk PTR_OFFSET); ! Set pointer to remainder B local storage 


Clear LOCAL storage, and allocate initial format buffer 


! ACTUALLY PROCESS THE’ PORMAT SPECIFICATION | 
FILL VAL {9 K LOCAL siz FMTDAT 


FMT_BUF_BEG = FORSSGET_VM (K_FMT bur INIT); 
ERICBUFISI? = K_FMT_ BUF. INIT? 


CPR "3 
FORMAT_PTR = CHSPTR (.FORMAT); 
FORMAT_PTR = CHS$FIND_ NOT CH ck -MAX_LENGTH, .FORMAT_PTR, %C° '); 


if CHOFALL (.FORMAT_PTR) OR CHSRCHAR_A (FORMAT_PTR) NEQ 2C'(' 
ERROR (ERRMISSDLM) 
BEGIN 
WHILE 1 DO 
CHAR = GNB; ! Get next non-blank 
IF .CHAR GTRU K_CLASS_TAB_MAX THEN ERROR (ERRFMTCHAR); 
CASE .CLASS C.CHAR] FROM 0 TO 29 OF 
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0408 4 SET 

0409 4 

9619 4 [0] : 

be 43 ? 0 = INVALID CHARACTER 

brig 4 EKPOR (ERRFMTCHAR); 

0414 4 

0415 4 C1) : 

0416 4 ! 1 = NULL CHARACTER 

0417 4 ' 

0418 4 ERROR (ERRFMTRPAR); 

0419 4 

bese 4 £2) : 

0421 4 ! 2 = MINUS SIGN 
04 ¢ 4 ' 

be Z 2 BEGIN 

Bos? 5 IF .SIGN NEQ 0 OR .TYPE NEQ O THEN ERROR (ERRFMTCHAR); 
0427 2 SIGN = -1; 

0428 4 END; 

44 4 
0430 4 [3] : 
0431 4 ! 3 = PLUS SIGN 
pes 4 ! 
ot 2 BEGIN 
oR H 2 IF .SIGN NEQ 0 OR .TYPE NEQ 0 THEN ERROR (ERRFMTCHAR); 
0437 5 SIGN = 1; 
0438 4 END; 
0439 4 
0440 4 [4] : 
0441 4&4 ' 4 = LEFT ANGLE BRACKET 
Bees 4 : 
0443 4 ERROR (ERRFMTCHAR); 
0444 4 
0445 4 [5]: 
0446 4 ! § = DIGIT 
baca BEGIN 
0449 5 TYPE = 1; 
0450 5 NVAL = .NVAL*10 + .CHAR = 'O'; 

bees 4 END; 

126 4 
0453 4 [6] : 

0454 4 ' 6 = LEFT PARENTHESIS 

0455 4 ' 

3628 5 BEGIN 

0457 5 NZERO (); 

bees 5 NSAVE (); 

3589 IF .NEST EQL 0 THEN PUTBYT (TOPLVL); 
Bie IF (NEST = .NEST + 1) GTR 8 THEN ERROR (ERRFMTNEST); 
0464 5 REDUCE (LPAREN); 
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2-006 =3007 138% 99: $73 3 AMARTL SRETFOREMTCD B33; 1 . (3). 
H 108 465 4 END; 

; 40 rh'¢ 4 

; 404 467 4 (7) : 

; 405 468 4 ! 7 = RIGHT PARENTHESIS 
; 406 0469 4 ; 
; 407 470 BEGIN 

; 408 471 
; 409 of6 4 ; | 
: 410 047 2 i When the VAX-11 FORTRAN compiler sees the sequence ‘’,)'', 
> 411 0474 i it issues a S verning morenge and otherwise ignores the 

; tig 0475 5 ' extra yy deliberate decision was made for | 
3 461 p78 2 ' release 2 to fl this occurrence entirely in the 
3 et3 bee é ‘ run-time format compiler. 
; 416 0479 5! if .CPRIME EQL "," THEN ERROR (ERRFMXTCOM); | 
; 417 0480 § 
>; 418 tt 5 UNDEFER (); 

: 419 0482 5 | 
: 420 0483 5 IF (NEST = .NEST = 1) LSS 0 THEN EXITLOOP; 
: 421 0484 5 
; t5§ 0485 5 PUTBYT (RPAREN); 
: 42 0486 4 END; 
: 424 0487 4 | 
: 425 0488 4 (8) : 

> 426 0489 4 ! 8 = SLASH 

> 427 0490 4 i 
; 428 0491 5 BEGIN | 
3 $9? 0492 5 UNDEFER (); 

; 430 0493 5 PUTBYT (SLASH); 
3 ce 0494 4 END; 
; 4 § 0495 4 

; 43 0496 4 (9) : 

: 434 0497 4 9 = DOLLAR SIGN 
3; 435 0498 4 
; 436 0499 5 BEGIN 

; 437 0500 § UNDEFER (); 
; 438 0501 5 PUTBYT (DOLLAR); 
3; 439 R206 4 END; 
; 440 0503 4 
3 (441 0504 4 (10) : 

3 44 0505 4 ! 10 = COLON 

: 44 0506 4 : 
3 4446 0507 5 BEGIN 
3 6445 B28 5 UNDEFER (); 

; 446 509 5 PUTBYT (COLON); 

3 447 0510 4 END; 

; 448 0511 4 

> 449 B26 4 C11) : 
; 450 051 4 ‘We COMMA 
3 «6451 0514 4 

3 $36 B21? BEGIN 

3; 45 218 

. 454 be + a ee ie: | oe 

3; «455 518 5 i The sequence ° is ignored here. See comment | 
: 456 0519 ; i under RIGHT PARENTHESIS” | 
: 458 0854 ! IF .CPRIME EQL *,* OR .CPRIME EQL ‘(* THEN ERROR (ERRFMXTCOM); 
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2-006 eames 1 90: 47:8 FORRTL.SRCIFORFMTCP.B3 31 ’ (3) 
: 459 05 
; 460 2 : 2 UNDEFER (); | 
: 461 4 4 END; | 
: 46 525 4 | 
: 46 05 $ 4 (12) : 
> 4664 0507 4 ' 12 = DECIMAL POINT | 
; 465 0508 4 i | 
: 466 0529 BEGIN 
: 467 0530 
; 468 03 1 2 IF .TYPE EQL 0 THEN ERROR (ERRFMTNUMB); 
: 470 0 § 5 IF .SIGN NEQ 0 THEN ERROR (ERRFMTRNGE); | 
: “ 9 ; ; IF .FCOUNT LSS 2 OR .PHASE NEQ 1 THEN ERROR (ERRFMTCHAR); | 
: 474 §238 5 NSAVE (); 
3; 475 0538 4 END; 
> 476 0539 4 
: 477 0540 4 (13] : 
> 478 0541 4 ! 13 = QUOTE 
: 679 0948 4 i 
: 480 0543 5 BEGIN | 
: 481 0544 5 
: 48 0545 5 LOCAL 
: 48 0546 5 P; | 
> 484 0547 5 
> 485 0548 5 UNDEFER (); 
; 486 0549 § P = .FORMAT_PTR; 
: 487 0550 5 
: 688 0551 5 
: 489 0938 6 BEGIN 
: 4690 0553 6 | 
: 491 0994 & 
: 49 0555 7 BEGIN 
; 49 0556 7 CHAR = GC; ! Get next character 
> 49% 0557 7 NVAL = .NVAL + 1; 
: 495 0558 7 END 
: 696 0559 6 WHILE .CHAR NEQ ''''; | 
: 497 0560 6 
: 498 0561 6 CHAR = GC; 
: 499 036¢ 6 END 
: 500 0563 5 WHILE .CHAR EQL ‘'''; 
; 501 0564 5 
: 202 0365 3 FORMAT_PTR = .P; 
3; 50 566 
3 504 0567 5 IF (NVAL = P = .NVAL = 1) EQL O THEN ERROR (ERRZLSTR); 
: 505 0568 5 
; 506 0569 5 TYPE = 1 
: 507 0570 5 PHASE = |; 
; 508 0571 5 NSAVE (); | 
3; 509 0372 5 REDUCE (HCODE); 
; 510 S73 : 
3: 511 0574 DECR I FROM .P TO 1 DO 
; 218 0378 6 BEGIN 
3; (51 376 6 
: 514 097 6 IF (CHAR = GC) EQL '''* THEN GC; 
> 515 578 6 
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1 
14- =hee- 984 1:59 FORRTL.SRCJFORF :1 (3 

1 19 = LETTER G 

DEFER (GCODE, 3); 


C20] : 
20 = LETTER H 


BEGIN 
LOCAL 
P; 
NZERO (); | 
IF .TYPE LSS 0 THEN ERROR (ERRFMTCHAR); 
| 
IF .TYPE EQL 0 THEN (NVAL = 1; TYPE = 1); | 
IF (P = .NVAL) EQL 0 THEN ERROR (ERRZLSTR); | 
PHASE = 1; 
NSAVE (); 
REDUCE (HCODE); | 
DECR I FROM .P TO 1 DO 
BEGIN 


PDD DP PVP PAPI SVS SV SVSVUSUSVSVSVSIVSVSVSUSISISIS 
SSS SVS SSS Ses eS SP SSeS tN SSNS 
DNAVLSWN—OODNAUSWN —“OOONOUSW 


CHAR = GC; 
PUTBYT (.CHAR); 

ND; | 

CHAR = 0; | 
END; 
| 

C21] : | 
121 = LETTER I | 
DEFER (ICODE, 2); 


C22] : 
"22 = LETTER L 


SEER (LCODE, 1); 


(23) : 
23 - LETTER O 


DEFER (OCODE, 2); | 


[24] : 
"24 = LETTER P 


BEGIN | 
NZERO (); 


IF .TYPE EQL 0 
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2=006 enee-1oke 98:95:88 | Ee AAT Obese ae Ne 0-286 «3 
: $87 0750 "LD: | 
; 688 751 DEFER (TLCODE, 1); 
; 689 07 ¢ | 
; 690 fi "R') ; 
; 691 Pee DEFER (TRCODE, 1) 
; 69 0755 
; 69 B2 28 COTHERWISE] : 
; 694 0757 6 BEGIN 
; 695 0758 6 DEFE TCODE, 1); 
; 6% 0759 6 FORMAT_PTR = .FORMAT_PTR = 1; | 
3; 697 0760 CHAR = 'T'; 
: 698 0761 END; | 
3; 699 O76¢ TES; 
: 700 0763 5 | 
; 701 0764 4 END; 
s 70 0765 4 
; 70 0766 4 (28) : 
; 704 0767 4 ! 28 = LETTER X 
; 705 0768 4 ! 
> 706 0769 5 BEGIN | 
s 707 0770 5 NZERO (); 
; 708 0771 5 
; 709 tae 5 IF .TYPE EQL 0 
> 710 0773 5 THEN | 
> 711 0774 6 BEGIN | 
; ne 0775 6 TYPE = 1; 
: 71 0776 6 NVAL = 1; | 
s 716 0777 5 END; 
s 419 0778 5 
: 716 0779 5 PHASE = 1; 
: 717 0780 5 NSAVE (); | 
: 718 0781 5 REDUCE (TRCODE); ' X is same as TR 
3; 719 1414 5 ! Old X is no longer used. 
; 720 07835 4 END; 
s fei 0784 4 
3; 722 0785 4 C29] : 
3; 723 0786 4 ' 29 = LETTER 2 
3: 726 0787 4 ! 
: 725 0788 4 DEFER (ZCODE, 2) | 
3; 726 0789 4 TES; 
3; 727 0790 4 | 
; 728 0791 4 CPRIME = .CHAR; 
3; 729 079 END; 
: a 878 
e i 794 ‘¢ 
s fae 0795 ! Put end of format code. 
; 735 0796 ' Then return size and location of format buffer. 
: 734 797 !- 
; 735 798 
: 73% 0799 PUTBYT CENDEMT) 5 
; 737 00 ALLOCATED_LEN t6 } = .FMT_BUF_SIZ; 
: 738 0801 ALLOCATED “ADR (OJ = .FMT_BUF “BEG: 
; 739 630s END; 
: 740 80 
: 741 0804 END: 


Ss 
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«TITLE Congseace FORTRAN OBJECT TIME FORMAT COMPILER 
-IDENT \2=006\ 


-PSECT _FORSCODE,NOWRT, SHR, PIC,2 


00 00 00 00 00 i 9000 P.AAA: BYTE \. . & & 0, : a 0. 0. 0 Q. g: : ; 
06 00 g 09 09 2 Sof 0, > Oe Oe . : a + 4 18, 6 . 
05 05 05 C 002d <> Sodas Ws a 5 4. 3.5. 5 : 
12 00 OF 00 04 0003C * 5.1 , & oO. 0°” 4 AL : 
00 00 19 16 00 00048 0; 16, 17,°18,°19; 26, 41, 0.0 : 

1D 005A 0, 23. 24, 25, 0, 26, 27, 0, 0, 0, $80, <j 


-—OoMT nH HHH Hn aeMenenn 


uma 
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OFFC 00000 ENTRY ie : FOnP ah. Save R2,R3,R4,R5,R6,R7,R8,-; 0294 | 
9 9008 MOVAB AAT BYT, R8 
3H MOVAB UNDEFER, R6 
0 1 MOVAB -76(SP), SP 


15 MOVAB FMTDAT, SAVVAL 0382 
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mn 


30 AE 04 002A8 56$: CLRL SIGN : 07 | 31 
28 Ag f DO 002AB MOVL #1, PHASE ; 0g ;] 
£ 0 FB OOOAF CALLS #0. NSAVE : 0704 | : 1 
C pp B2 PUSHL wie + 0705 | 3] 
OODF 31 002B4 BRW 74 : : 1 
66 00 FB B7 57$: CALLS #0, UNDEFER : Orig 31 
14 DD OOOBA PUSHL #26 + 0713) 31 
45 11 002BC BRB 62$ : | 31 
66 6 FB OOCBE 58$ CALLS # UNDEFER + 0720) :1 
64 FFFF BF 38 02C1 SKPC = #32, - #65535, (FORMAT_PTR) t 0722) 31 
é 12 002¢7 BNEQ 59$ : | : 1 
2 D4 0 ¢9 CLRL eR : : 1 
54 1 09 CB 59$ MOVL R11, FORMAT_PTR : | 3:1 
50 31 dR § 5 BOVIBL an PTR)+, C : | 
00000061 8F 8% D1 8 D3 CMPL  C, #97 ~ ; :] 
OC 1F O02DA BLSSU-60$ : | : 1 
0000007A BF 50 D1 00 DC CMPL = C,-#122 : 31 
03 1A O02E BGTRU 60$ : : 1 
50 20 C2 00265 SUBL2 #32, RO : 31 
52 0 DO 00268 60$:  MOVL  C, CHAR : 31 
00000050 =F 52 D1 00 EB CMPL CHAR, #80 + 0725 31 
04 12 OOF BNEG 61$ : 31 
OA DD 002F4 PUSHL #10 + 0726 3:1 
08 11 002F6 BRB 62$ : 31 
00000053 BF 52 D1 O02F8 618: CMPL CHAR, #83 : 0728 | 31 
0? 12 O0¢rF BNEG  63$ : | ‘1 
0B DD 00301 PUSHL #11 : 0729) 31 
68 01 FB 00303 62$: CALLS #1, PUTBYT : 31 
71 11 00306 BRB 71$ : | 31 
09 DD 00308 63$:  PUSHL #9 : 0733 31 
68 01 FB OO30A CALLS #1, PUTBYT : | 31 
54 07 0030D DECL FORMAT PTR + 0734 ‘7 
52 53. BF 9A 0030F MOVZBL #83, CRAR : 0735 : 1 
64 11 00313 BRB 71$ + 0407 31 
66 00 FB 00315 64$: CALLS #0 UNDEF ER > 0745 31 
64 FFFF © BF 20 38 00318 SKPC =—s-s#32,,:- #65535, (FORMAT_PTR) : 0747 :1 
02 12 00 IE BNEQ  65$ : 31 
51 D4 0032 CLRL—sRY : : 1 
54 51 rt 0 ;o MOVL R1 FORMAT_PTR b 
OA 12 00 BNEQ 67$ F 
E DD 00327 66$ PUSHL #62 ; 
000000006 00 01 FB 00 ° ALLS #1, FORSSSIGNAL_STO 
50 84 gr 0331 67$ MOVZBL (FORMAT_PTR)+, C : 
00000061 8F 0 D1 00334 CMPL so, «#97 
o¢ 1F 00338 BLSSU b6s ; 
0000007A =F 6 D1 00 D CMPL =sC,,_:-#122 
03 1A 6 44 BGTR obs : 
50 0 C3 46 SUBL2 #32, RO ; 
52 0 D 0 49 68%:  MOVL CC, ¢ ; | 
0000004c =F 2 D1 0034 CMPL CHAR, #76 : 0750 | 
6 12 00 BNEG  69$ ; | 
1 0D 6 PUSHL #1 : 0751 | 
2 DD 7 PUSHL #1 ; 
46 11 00359 BRB 76 ; 
00000052 —s BF 52 D1 00358 69%: CMPL = CHAR, ~#82 : 0753 | 
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6 12 00362 BNEQ 708 ; | i] 
0D PUSHL #1 + 0754) : 1 
0D 6 PUSHL #19 ; | i] 
11 BRB 76$ ; | i] 
1 DD 0036A 708 PUSHL #1 3 0758) 3] 
D DD C PUSHL #13 ; | :] 
0000V CF 2 FB CALLS #2, DEFER : :] 
4 p DECL. FORMAT_PTR + 0759) . 7 
52 54 F 9A 0037 MOVZBL #84, CRA : 0760 :] 
B 11 79 71$: RB 77$ 3 0407 : 1 
0000v CF F 7B 72$: CALLS #0, NZERO : 0770 3 
38 AF D TSTL «TYPE : 0772 3] 
1 BNEQ 73$ : : 3 
8 AE 1 OD 0 MOVL #1, TYPE : 0775 ; 1 
4 AE 1 OD 9 MOVL #1, NVAL 3 0776 3 1 
28 OA 01 DO 0038D 73$: MOVL #1, PHASE : 0779 31 
fy 09 FB 99 91 CALLS 0, NSAVE : 0780 31 
13 DD 00394 PUSHL @# + 0781 31 
0000v CF 01 FB 00 96 748: CALLS #1, REDUCE ; :] 
09 11 0039B BRB 77$ + 0407 31 
02 DD 00390 75$: PUSHL #2 : 0788 31 
19 DD 0039F PUSHL 5 : ; 1 
0000v CF 02 FB OO3A1 76$: CALLS #2, DEFER : :] 
44 AE 52 DO 003A6 77S: MOVL CHAR, CPRIME : 0791 31 
FCBO 31 OO3AA BRW 2$ ; 0401 a | 
04 DD OO3AD 78$: PUSHL 4&4 + 0799 31 
4B 01 FB OO3AF CALLS #1, PUTBYT : 31 
08 BC 48 AE BO 00382 MOVW FMT_BUF_SIZ, @ALLOCATED_LEN 3 0800 3:1 
0c BC 40 AE 00 00387 MOVL FMT_BUF_BEG, @ALLOCATED_ADR ; 0801 a. 
04 0038C RET ; 0804 : } 
; Routine Size: 957 bytes, | Routine Base: _FORSCODE + 0058 sf 
:1 
; 742 0805 1 ; 
i] 
3:1 
| 
2.4 
| :] 
| : 1 
j : 1 
7 
24 
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> 744 06 1 ROUTINE REDUCE (C) : CALL_G3 NOVALUE = 

: 745 5 1 

; 746 8 1 ite 

; oe 94 1 : FUNCTIONAL DESCRIPTION: 

; 749 oat 1! utput the compiled text corresponding to the format item 

3 728 0 \¢ 1! ust scanned 

; 751 0815 1! 

3 Pe 0814 1 ! FORMAL PARAMETERS: 

; 75 0815 1! 

: 754 pale 1! C - format code 

; 755 +9 . 7 

; 756 16 1°! IMPLICIT INPUTS: 

3; for 0819 1! 
; 758 0820 1! FMTDAT array 
; 759 0821 1! 

: 760 08 ; 1! 

3; 761 08 1 ! IMPLICIT OUTPUTS: 

; Pog base . | 

: 76 0825 1! Compiled text output through argument 

; 764 08 § 1! Reinitialization for another format item (per format code related 

s 769 08 1! FMTDAT array updated) 

: 766 0828 1! 

: 767 O8¢9 1 | ROUTINE VALUE: | 
: 768 0830 1! 

3; 769 0831 1! NONE 
; 770 oeas he 

3 7ry 08335 1 ! SIDE EFFECTS: 

3; 77 0834 1! ‘ 

s 7 0835 1! SIGNAL_STOPs FORSSYNERRFOR (62="'SYNTAX ERROR IN FORMAT'') | 
: 774 0836 1! 

: 775 0837 1 i-- | 
: 76 0838 1 

: 777 0839 2 BEGIN ; 

s ee 0840 § EXT_REG; ! Declare external registers 
3; 779 0841 
: 780 Bae MACRO | 
; 781 M 084 ALLBITS = 

3; 782 0844 0,0,32,0%, ! WHOLE WORD 
; 783 M 0845 RSBITS = 

3; «784 0846 0,0,2,0% ' REP COUNT SIZE 

; 785 M 0847 §B1T = 

3; 786 0848 0,2,1,0%, ! W FIELD SIZE 

3: 787 M p84? XBIT = 

OR. 50 0,7,1,0%; ! REPETITION COUNT EXISTS 

; «6789 0851 

; 790 Bag MACRO 

3 jaa] Baez ; Macro to pack flags for table FMT_PRM_LIMITS 

: 795 : 0855 5 FLAGBITS (FO, F1, F2, F3, F4, FS, F6, F7) = 

: 795 M One? (FO) OR (F1)*1 OR (F2)*%2 OR (F3)43 QR 

; 796 858 (F4)*4 OR (F5)*5 OR (F6)*6 OR (F7)*7 & 

; 797 859 ' Field definitions for table FMT_PRM_LIMITS 

; 798 860 : 

: 799 mM 0861 FDFLTOK = 

; 800 0862 0,1,0%, ' Allows defaults if no parameters follow 


actly one parameter 


e ex 
MITS 


av 
LI 
after a format edit 


edit type. 
ecifiers not in the table 


' Does not allow W without D 


' Allows Wor W.M 
! Allows E type exponent 


' Must h 


Llow abbreviated reference to table FMT_PRM_ 
an 


egit’s 
sp 
(S, SS, SP, P, '(* ) do not allow following parameters. 


n 


ptions for parameters 
po 


Each row corres 


e bits are defined above. 


Table of default o 
ecifier. 


: 


FMIN2 = 
T 


4,1,0%, 
' Macro to a 
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Format code with modifications 


VFE mask byte 
Mask bit to or in to VFEM 


which might have to be adjusted for 


g to reduce 
a variab.ie number of parameters 


' If C is zero, there is nothin 
Check whether this is a code 


IF (FC = .C) NEQ 0 


Or UM TN OR. OD 
uh auth meh meh eh, eh ee ee ee 
APOOOCOOCOAOA 
COOOCOCoooecooe 


DOR. DOO— UM TMOR. DOOM UM TNOR. OD 
Se OS SS SESS 
€O GO 60 60 G0 60 GD 60 60 G0. 60 60 GO O O OO A OOOO 
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BEGIN 
' The ne block-IF checks for parameter pated 
ormat code for formats which allow variable numbers of 


' the correct 


parameters. 
—_—" C1] EQ. 0 
' No parameters are present. If allowed, adjust format codes to 
: indicate that defaults are being taken; otherwise, error. 
BEGIN 
IF FMT_CHECK (FDFLTOK) 
THEN 
BEGIN 
= .FC + OFFSET; 
SAVTYP [C2] = SAVTYP (3) = 0; 
END 
ELSE 
IF FMT_CHECK (FIEXACT) THEN ERROR (ERRFMTNUMB) 
END 
ELSE 
atid (2) EQ. 0 
! WwW field with no D field. This is an error for floating point 
edit types 
BEGIN 


IF FMT_CHECK (FMIN2) 
THEN 
BEGIN 
ERROR (ERRFMTNUMB) ; 
END 
END 
ELSE 


IF .SAVTYP [3] EQL 0 
THEN 


! Wand D present, but not E. Check if this is W.M type and 
adjust format code if so. 


BEGIN 
IF FMT_CHECK (F1OR2) THEN FC = .FC + IOZOFFSET 
END 


ELSE 
' W.D.E present. If allowed, adjust format code, otherwise error. 


oe 
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' 
IF FMT_CHECK (F20R3) THEN FC = .FC + EGOFFSET; 
END; 
IF .C EQL HCODE AND (.SAVVAL C1] LSS 0 OR .SAVTYP [1] LEQ 0) THEN ERROR (ERRHOLLCNT); 
Compute the VFE-mask 


VFEM CALLBITS) = 0; 
' Compute S$ and RS fields 


' 
! If rep count is absent (SAVTYPLO) = 0), is a VFE, or is 1, then 
' RSBIT = 0; otherwise it is the number of bytes necessary to 
} represent the repetition count. 
- aah CO] LEQ 0 OR .SAVVAL CO) EQt 1 
ns VFEM CRSBITS) = 0 

BYTSIZ (.SAVVAL ([0)); 


VFEM CRSBITSJ 
IF .C NEQ PCODE AND .SAVTYP [1] NEQ -1 
VFEM CSBIT) = BYTSIZ (.SAVVAL [1]) - 1 
VFEM CSBITJ = 0; 
VFEB = %0°200'; 
INCR_ 1 FROM 0 TO 3 DO 
BEGIN 


IF .SAVTYP C.1] LSS 0 THEN VFEM = .VFEM OR .VFEB; 
VFEB = .VFEB*(-1); 
END; 


IF .VFEM CALLBITS] NEQ O THEN FC CXBIT) = TRUE; 


' Output the code 
Also, check range of constant parameters 


PUTBYT (.FC); 
IF .VFEM CALLBITS) NEQ 0 THEN PUTBYT (.VFEM CALLBITS)); 
INCR I FROM 0 TO 3 DO 
CAGE GOT? C.1] FROM -1 TO 1 OF 
Case -1 Variable format expression 


{-1] : 


uu 
1oO 
= 


a ee ee ee ee ee ee ee ee SS SS SS 


Hm 
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2-006 t8ep=1986 19:91:59 ERORRIL SRESFORFMTCP.O35: 1 oo 


s 97 18 4 ERROR (ERRFMTCHAR); 

; 97 1035 ' Case Not present 

3; 974 10 § ! 

; 975 10 

; 976 1038 (0) : 

; 977 1039 0; 

; 978 1040 ' Case +1 Constant 

3; 979 1041 ! 

; 980 ek 

; 981 104 (1) 

; 98 1044 4 BEGIN | 

; 98 138? 4 

; «984 1046 4 CASE .1 FROM 0 TO 3 OF 

: 985 1047 4 SET 

; 986 1048 4 ' 0 = Repetition factor 

; 987 1049 4 ! 

; «988 1050 4 

; 989 1051 4 [0] : 

: 990 1926 5 BEGIN 

; 991 1053 5 

b 338 1054 5§ IF .SAVVAL [CO] LEQ 0 THEN ERROR (ERRFMTRNGE); | 

; 99 1055 § | 

: 994 1838 5 IF .SAVVAL CO) NEQ 1 | 

; 995 1057 5 THEN 

; 996 1058 6 BEGIN 

; 997 1059 6 PUTBYT (.SAVVAL ([0)); 

; 998 1060 6 

; 999 1061 6 IF .VFEM CRSBITS) EQL 2 THEN PUTBYT (.SAVVAL (0)/256); 

; 1000 1998 6 

: 1001 1063 5 END; 

3 18 1064 5 

: 100 1065 4 END; : 

3: 1004 1066 4 ' 1 = Width or scaling factor 

3; 1005 1067 4 ! | 3 
; 1006 1068 4 3 
: 1007 1069 4 (1) : | : 
: 1008 1070 5 BEGIN 3 
; 1009 1071 5 | ; 
; 1010 1076 5 IF .C EQL PCODE ; 
3: 1011 1073 5 THEN F 
: a 1074 § | ; 
3; 101 1075 5 IF .SAVVAL C1) LSS -128 OR .SAVVAL £1] GTR 127 

3 1014 1076 5§ | 

3; 1015 1077 6 ERROR (ERRFMTRNGE) 

3: 1016 1078 5 E 

3; 1017 1079 5§ 

3; 1018 1080 5 

3: 1019 1081 5 ELSE 

: 1020 1036 5 

3: 1021 10 5 IF .SAVVAL C1] LSS 0 THEN ERROR (ERRFMTRNGE); 

3 19¢¢ 1084 : 

3; 102 1085 PUTBYT (.SAVVAL (1)); 

: 1024 1036 2 

3; 1025 108 IF .VFEM CSBIT) NEQ 0 THEN PUTBYT (.SAVVAL (£1)/256); 

3 1066 1088 5§ 

3; 102 1089 4 END; | : f 

; 1028 1090 4 ' 2 = Decimal field width 


11 | 
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16- 
14- 1:59 FORRTL.SRCJFORFMTCP.B32;1 


C2) : 
BEGIN 


IF .SAVVAL C2] LSS 0 OR .SAVVAL [C2] GTR 255 THEN ERROR (ERRFMTRNGE); 
PUTBYT (.SAVVAL (2)); 
! 3 = Exponent field 


WWW 


AVS WM COONAN E WN “OVO ONOUES WO” 


BEGIN 

IF .SAVVAL C3] LSS 0 OR .SAVVAL C3] GTR 255 THEN ERROR (ERRFMTRNGE); 
PUTBYT (.SAVVAL (3)); 
END; 
TES; 


, at et 


END 
TES; 


END; 
a (0, ZUPVAL*(K_PTR_OFFSET + L_NEST), SAVVAL (0])); ! Zero to but not including NEST 


Se Oe Se Se Ge Ge Be Ge Ge Oe Se ee SHS Se SHS Se Se Se Se ee SHS Se Se See 
ee a a 2“ =) Lg —) 2 2 = = “2 2 s  _s — sd 


oo 
a kk kk dd 


PIII ME BB ED BB EIT 


MVM 


00 00 05 05 05 01 01 00 10 10 00 00 00 00 10 00418 P.AAB: .BYTE 16, 0, 0, 0. 0, 16, 16, 0. 1.1.5, 5,5.°: 
0B OB 0B 03 00 00 00427 S. & Be Oe ee Te thn 8 ; 
| 
FMT_PRM_LIMITS= P.AAB | 
007C 00000 REDUCE: .WORD Save R2,R3,R4,R5.R6 : o00s | 
56 0000v CF 9E 90002 MOVAB  PUTBYT, R6 : | 
55 04 AC dO 0000 MOVL CC, RS + 0914 | 
53 55 00 00008 mMOVL RS, FC ; 
03 12 OO000E BNEQ =«'1$ F 
0168 31 90019 BRW 34$ ; 
0D 33 D1 0001 1$: CMPL =e, #13 : 0921. 
9 19 00016 BLSS 8S : | 
52 C2 AF4S i 0018 MOVAB FMT_PRM_LIMITS-13(R5], R2 : 0936 
04 AA D5 00010 TSTL 4(SAVTYP) 3; 0929 
11 iF 0020 BNEG 3$ ; 
08 62 €9 000 ‘ BLBC (RQ), 2$ : 0936 
5 14 c0 00 ADDL2 #20, FC : 0939 
08 AA 7C 00028 CLRO (SAVTYP) : 0940 | 
24 11 00028 BRB $ : 0934. 
20 62 4 3 D 28: BBC #4, (R2), 8S > 0944 
09 11 1 BRB 4$ ; 
08 AA p 3 3$: TSTL (SAVTYP) : 0949 | 
07 0 BNEQ : | 
15 62 01 €1 000 BBC #1, (R2), 8$ ; 0956, 
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ay ROUTINE NSAVE : CALL_G3 NOVALUE = 

35 144 

a7 ! FUNCTIONAL DESCRIPTION: 

a2 Save the values of PTRCL_NVAL] and PTRCL_TYPE] in SAVTYP and SAVVAL 

44 FORMAL PARAMETERS: 

99 None 

00 

9! IMPLICIT INPUTS: 

08 PTRCL_NVAL - value of a_ numeric term 

04 PTRLL_TYPE - PTREL_TYPE] of the numeric term 

05 PTRLL_SIGNJ - indicator if a minus gtit SIGN]_has been _encounted 

PTRCL_PHASEJ - indicator of what the PTRCC_NVAL] and PTRIL_TYPE] associate 


to repetition count, Wor D. 
IMPLICIT OUTPUTS: 
FMTDAT array | 
ROUTINE VALUE: 
NONE | 
SIDE EFFECTS: 
SIGNAL_STOPs FORSSYNERRFOR (62=""SYNTAX ERROR IN FORMAT'') 


Rt ee ee ee I ee ee ee ee ee ee ee ee ee et 


BEGIN 

EXT_REG; ! Declare external registers 
IF .PTR CL_SIGN) NEQ 0 THEN ERROR (ERRFMTPTR CL_SIGN)); 

SAVVAL pore L_PHASEJ] = .PTR CL_NVAL]; 
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29 SAVTYP C.PTR_CL_PHASEJ) . PTR CL_TYPE); 
30 PTR L PHASE) =".PTR CL_PHASE] + T; 
31 PTR CL-SIGN) = 0; 
32 PTR CL-NVAL) = 0; 
33 PTR CL-TYPE) = 0; 
4 END; | 
| 
0000 00000 NSAVE: .WORD Save nothing 5 1248 | 
10 a9 D3 0008 STL 16(PTR) > 1284. 
A 13 0000 FQ. = s«1$ ; | 
E pd 00007 PUSHL #62 ; | 
000000006 00 1 FB 9009 CALLS #1, FORSSSIGNAL_STO | 
50 08 A9 DO 00011 18: MOVL  8(PTR), RO ; 1286 
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ROUTINE PUTBYT (V) : CALL_G3 NOVALUE = 
! 


i FUNCTIONAL DESCRIPTION: 

Output a byte through argument 
FORMAL PARAMETERS: 

V - vaule to be output 
IMPLICIT INPUTS: 

FMTDAT array 
IMPLICIT OUTPUTS: 

FMTDAT array 
ROUTINE VALUE: 

NONE 
SIDE EFFECTS: 


—— 


SIGNAL_STOPs FORSSYNERRFOR (62=""SYNTAX ERROR IN FORMAT’) 


BEGIN 
LOCAL 

A_OLD_BUF _BEG; ! Place to save old format buffer address 
EXT_REG; ! Declare external registers 


1+ 
! Check if room in currently allocated format buffer 


! If not allocate twice as much and copy old format buffer, 


then deallocate old format buffer. 
IF .PTR CL_NCHAR] GEQ .PTR CL_FMT_BUF_SIZ] 
THEN 


BEGIN 
A_OLD_BUF_BEG = .PTR CA_FMT_BUF_BEG); 
IF .PTR CL_FMT_SUF_SIZ] GEQ 32768 THEN ERROR (); 


PTR CA_FMT_BUF_BEG) = 

CHSMOVE (.PTR CL_FMT_BUF_SIZJ,~.A_OLD_BUF BEG 

FORSSFREE_VM (.PTR CC_FMT BUF _siZ] -A_OLO BUF BEG); 
] =". PTR CLFMT_BuUF_S12)#2; 


4h, CL_FMT_BUF_SIZ 
1+ 
! Store away the byte in format buffer 


FORSSGET_VM (PTR CLAEMT BUF S1Z]#2): 
TR CA_FMT BUF _BEG)); 
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FORSSFMTCP FORTRAN OBJECT TIME FORMAT COMPILER 16-Sep-1 3: AX-11 Bliss-32 V4.0-74 Pa 9. 
2-006 12: Sep- 198 99: 7 £88 PORRTL SREIFORFMTCE. B39; 1 10), 
4 1 OF BGEQ ~=s:'1$ P : 
50 8% 06 1} Rov. #1, RO ; 1397, 
00010000 = 8F 52 D1 00015 18: CHPL 2, #65536 : 1400, ; 
04 18 1¢ BGEQ : ; 
50 02 D O01 MOVL #2, RO : ; 
04 00 RET : | : 
3E DD 2 28: PUSHL #62 : | ; 
000000006 00 01 FB 90 4 CALLS #1, FORSS$SIGNAL_STO ; F 
0 D4 00028 CLRL =. RO : | ; 
04 00020 RET ; 1402 | ; 
; Routine Size: 46 bytes, | Routine Base: _FORSCODE + 067C ; 
> 1347 1403 1 END | : 
> 1348 1404 F 
> 1349 1405 0 ELUDOM | 
| 
: 
3 
: PSECT SUMMARY 3 
: Name Bytes Attributes ; 
;  _FORSCODE 1706 NOVEC,NOWRT, RD, EXE, SHR, LCL, REL, CON, PIC,ALIGN(2) | ; 
| 
| : 
; Library Statistics | : 
ee on eee as See = ee alas On ek ee Symbols -------- Pages Processing | ; 
; File Total Loaded Percent Mapped Time ; 
: _$255spuaz8: : CSYSL IBISTARLET 32:1 9776 0 0 581 00:01.0 | : 
> 7$255$DUA28:CFORRTL.OBJJFORLIB..32;1 711 2 0 52 00:00. > ; 
; ~$588SDUA 28: CFORRTL.OBJIRTLLIB.L 32:1 36 0 0 a 00:00.1 | : 
; COMMAND QUALIFIERS | 3 
: BLISS/CHECK=(FIELD, INITIAL, OPTIMIZE) /NOTRACE/LIS=LIS$:F ORFMTCP/OBJ=OBU$:FORFMTCP MSRC$:FORFMTCP/UPDATE=(ENHS:FORFMTCP) ; 
> Size: 1594 code + 112 data bytes ; 
3; Run Time: 330. | 
3; Elapsed Time: 1:28.9 
3: Lines/CPU Min: 23 g 
; Lexemes/CPU-Min: 169 
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3 penery Used: 326 pages 
; Compilation Complete 
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